home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b8.d64 / demo 4.1.b.l < prev    next >
Text File  |  2007-02-28  |  1KB  |  80 lines
  1. 0010 PROC INIT 
  2. 0020 SETGRAPHIC 0
  3. 0030 HIDETURTLE 
  4. 0040 FULLSCREEN 
  5. 0050 BACKGROUND 0
  6. 0060 BORDER 0
  7. 0070 ENDPROC INIT
  8. 0080 //
  9. 0090 PROC SQUARE(H,V,L) CLOSED
  10. 0100 MOVETO H,V
  11. 0110 FOR LOOP:=1 TO 2 DO
  12. 0120 FORWARD L*.75
  13. 0130 RIGHT 90
  14. 0140 FORWARD L
  15. 0150 RIGHT 90
  16. 0160 ENDFOR LOOP
  17. 0170 ENDPROC SQUARE
  18. 0180 //
  19. 0190 PROC POLY(H,V,L,S) CLOSED
  20. 0200 MOVETO H,V
  21. 0210 FOR LOOP:=1 TO S DO
  22. 0220 FORWARD L
  23. 0230 RIGHT 360/S
  24. 0240 ENDFOR LOOP
  25. 0250 ENDPROC POLY
  26. 0260 //
  27. 0270 PROC CIRCLE(H,V,SCALE) CLOSED
  28. 0280 MOVETO H,V
  29. 0290 ASPECT:=1.3
  30. 0300 Y:=0
  31. 0310 FIRST:=TRUE
  32. 0320 D'THETA:=.1
  33. 0330 C:=COS(D'THETA)
  34. 0340 S:=SIN(D'THETA)
  35. 0350 NUM:=64
  36. 0360 FOR LOOP:=1 TO NUM DO
  37. 0370 TEMP:=SCALE*C-Y*S
  38. 0380 Y:=Y*C+SCALE*S
  39. 0390 SCALE:=TEMP
  40. 0400 SX:=ASPECT*SCALE+H
  41. 0410 SY:=V-Y
  42. 0420 IF FIRST THEN
  43. 0430 MOVETO SX,SY
  44. 0440 FIRST:=FALSE
  45. 0450 ELSE 
  46. 0460 DRAWTO SX,SY
  47. 0470 ENDIF 
  48. 0480 ENDFOR LOOP
  49. 0490 ENDPROC CIRCLE
  50. 0500 //
  51. 0510 INIT
  52. 0520 COUNTER:=0
  53. 0530 REPEAT 
  54. 0540 COUNTER:=COUNTER+1
  55. 0550 SCALE:=RND(5,40)
  56. 0560 L:=RND(5,40)
  57. 0570 S:=RND(3,8)
  58. 0580 H:=RND(0,320)
  59. 0590 V:=RND(0,200)
  60. 0600 PENCOLOR RND(1,15)
  61. 0610 CT:=RND(1,3)
  62. 0620 CASE CT OF
  63. 0630 WHEN 1
  64. 0640 POLY(H,V,L,S)
  65. 0650 IF COUNTER>20 THEN
  66. 0660 COUNTER:=0
  67. 0670 CLEAR 
  68. 0680 ELSE 
  69. 0690 NULL
  70. 0700 ENDIF 
  71. 0710 WHEN 2
  72. 0720 SQUARE(H,V,L)
  73. 0730 WHEN 3
  74. 0740 CIRCLE(H,V,SCALE)
  75. 0750 OTHERWISE 
  76. 0760 NULL
  77. 0770 ENDCASE 
  78. 0780 UNTIL KEY$<>CHR$(0)
  79. 0790 END 
  80.